home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGNG_C / DBTOOLC.LZH / SOURCE.ARC / DCT1.C < prev    next >
C/C++ Source or Header  |  1987-09-17  |  32KB  |  1,375 lines
  1. #include <stdio.h>
  2. #include <ctype.h>
  3. #include "dctmain.h"
  4.  
  5. /* 
  6. *   NAME:
  7. *       DCT1.C - dBASE C Tool (Version 1.4) - Main Module
  8. *
  9. *   SYNOPSIS:
  10. *
  11. *   DESCRIPTION:
  12. *       Contains function table and other globabl initialization,
  13. *       and jacketed routines that are called by dBASE.
  14. *   
  15. *   RETURNS:
  16. *       Most functions don't have a C return value; instead, they
  17. *       poke a value into a dBASE memory variable
  18. *   
  19. *   NOTES:
  20. *       Ver 1.1 must use the LARGE model, and must be linked with
  21. *       c_catch.obj and dctmain.obj
  22. *
  23. *   AUTHOR: J. T. Cooper
  24. *
  25. */
  26.  
  27.  
  28. /* 
  29. *       INSERT YOUR #include STATEMENTS HERE
  30. */
  31.  
  32. #ifdef LATTICE
  33. int _stack = 8192;
  34. #endif
  35. /* For Aztec users, the following values replace those in the STKSIZ.O
  36.  * module in Aztec's C.LIB library (see Aztec docs)
  37.  */ 
  38.  
  39. #ifdef AZTEC
  40. int _STKSIZ = 4096/16;  /* (in paragraphs) */
  41. int _HEAPSIZ = (4096+1024)/16; /* (in paragraphs) */
  42. int _STKLOW = 1;        /* change to heap above stack */
  43. #endif
  44.  
  45. /* globals used by many functions */
  46.  
  47. char    dt_token[128];      /* storage for parsing tokens */
  48. char    dt_fname[36];       /* retains name function is called by */
  49.  
  50. char    *BigBuf1, *BigBuf2;
  51.  
  52.  
  53. /* 
  54. *           DECLARE YOUR FUNCTIONS
  55. *   
  56. *   C needs to know the names before getting to the structure assignment.
  57. *   We have adopted a convention of dt_... for dispatched functions. Any 
  58. *   functions you add must be referenced here.
  59. */
  60.  
  61. #ifdef MS
  62. int
  63. #else
  64. void    
  65. #endif
  66.     dt_acos(), 
  67.     dt_amort(), 
  68.     dt_arand(),
  69.     dt_arestore(), 
  70.     dt_asave(), 
  71.     dt_asin(), 
  72.     dt_atan(), 
  73.     dt_chi(),
  74.     dt_clrwindow(),
  75.     dt_corr(), 
  76.     dt_cos(), 
  77.     dt_count(), 
  78.     dt_covar(), 
  79.     dt_crarray(), 
  80.     dt_cv(), 
  81.     dt_dist(), 
  82.     dt_dumparray(), 
  83.     dt_eqn(), 
  84.     dt_fdump(),
  85.     dt_frarray(), 
  86.     dt_fv(), 
  87.     dt_gen(), 
  88.     dt_getarray(), 
  89.     dt_getpass(), 
  90.     dt_getsize(),
  91.     dt_gtn(), 
  92.     dt_help(), 
  93.     dt_irr(), 
  94.     dt_kurt(), 
  95.     dt_len(), 
  96.     dt_ltn(), 
  97.     dt_max(), 
  98.     dt_median(), 
  99.     dt_mean(), 
  100. #ifdef LATTICE      
  101.     dt_memstat(),
  102. #endif      
  103.     dt_min(), 
  104.     dt_mirr(), 
  105.     dt_npv(), 
  106.     dt_nsk(), 
  107.     dt_peek(), 
  108.     dt_poke(), 
  109.     dt_pmt(), 
  110.     dt_putarray(),
  111.     dt_putwindow(),
  112.     dt_pv(),  
  113.     dt_rand(), 
  114.     dt_range(), 
  115.     dt_rnarray(), 
  116.     dt_ros(), 
  117.     dt_setbell(), 
  118.     dt_setdvar(), 
  119.     dt_seterr(), 
  120.     dt_sf(),
  121.     dt_sin(), 
  122.     dt_skew(), 
  123.     dt_sound(), 
  124.     dt_starray(), 
  125.     dt_stdev(), 
  126.     dt_tan(), 
  127.     dt_var();
  128.  
  129. char    *fc_array();    /* returns pointer to an array of a given name */
  130.  
  131. /* 
  132. *   The Lattice extern variable _tsize is the current size of the program,
  133. *   in paragraphs; this is exactly what db_c_catch() wants, so let's use
  134. *   that.
  135. */
  136.  
  137.  
  138. /* 
  139. *           DO THE STRUCTURE ASSIGN
  140. *   
  141. * See DCTMAIN.H for description of elements. This is the table referred to
  142. * in the docs as the 'dispatch' table.
  143. */
  144. struct  ci_DT ci_DispTable[] =
  145.     {
  146.     "ACOS", dt_acos, 
  147.         "<x> - Compute arccosine of <x>",
  148.     "AMORT", dt_amort,
  149.         "<prin>, <rate>, <periods>, <pmts> - Amortization function",
  150.     "ARAND",dt_arand,
  151.     "<array>[,<factor>, <start>, <end>]",
  152.     "ARESTORE", dt_arestore,
  153.         "<array>,<filename>[,<start>,<end>] - Restore array from disk",
  154.     "ASAVE", dt_asave,
  155.         "<array>,<filename>[,<start>,<end>] - Save an array to disk",
  156.     "ASIN", dt_asin,
  157.         "<x> - Compute arcsine of <x>",
  158.     "ATAN", dt_atan,
  159.         "<x> - Compute arctangent of <x>",
  160.     "CHI", dt_chi,
  161.         "<expected>,<observed>[,<size>] - Chi-Squared Statistic",
  162.     "CLRWINDOW", dt_clrwindow,
  163.         "<y1>,<x1>,<y2>,<x2>,<flag> - Clear a window to spaces",
  164.     "CORR", dt_corr,
  165.         "<xarray>, <yarray>[,<size>] - Correlation of two arrays",
  166.     "COS", dt_cos,
  167.         "<r> - Compute cosine of <r> radians",
  168.     "COUNT", dt_count,
  169.         "<array> - Count the number of items in <array>",
  170.     "COVAR", dt_covar,
  171.         "<xarray>, <yarray>[,<size>] - Covariance of two arrays",
  172.     "CRARRAY", dt_crarray,
  173.         "<id>, <n>, <type> - Create an array",
  174.     "CV", dt_cv,
  175.         "<array>[,<size>] - Calc. coefficient of variance",
  176.     "DIST", dt_dist,
  177.         "<array>, <d>, <f>[,<size>] - Dist. Frequency",
  178.     "DUMPARRAY", dt_dumparray,
  179.         "<array>, <first>, <last> - Display contents of an array",
  180.     "EQN", dt_eqn,
  181.         "<value>, <array>[,<size>] - Number = <value>",
  182.     "FDUMPARRAY", dt_fdump,
  183.         "<array>, <file>, <first>, <last> - Dump array to file",
  184.     "FRARRAY", dt_frarray,
  185.         "<id> - Free the array <id>",
  186.     "FV", dt_fv,
  187.         "<pmt>, <rate>, <term> - Future Value function",
  188.     "GEN", dt_gen,
  189.         "<value>, <array>[,<size>] - Number >= <value>",
  190.     "GETARRAY", dt_getarray,
  191.         "<id>, <index> - Get a value from an array",
  192.     "GETPASS", dt_getpass,
  193.         "- Get a password from the operator",
  194.     "GETSIZE", dt_getsize,
  195.         "<array> - Return the size of an array",
  196.     "GTN", dt_gtn,
  197.         "<value>, <array>[,<size>] - Number > <value>",
  198.     "HELP", dt_help,
  199.         "[function] - List functions in library (you just called it)",
  200.     "IRR", dt_irr,
  201.         "<guess>, <flows>, <n> - Internal Rate of Return",
  202.     "KURT", dt_kurt,
  203.         "<zarray>[,<size>] - Sample Kurtosis",
  204.     "LTN", dt_ltn,
  205.         "<value>, <array>[,<size>] - Number < <value>",
  206.     "LEN", dt_len,
  207.         "<value>, <array>[,<size>] - Number <= <value>",
  208.     "MAX", dt_max,
  209.         "<array>[,<size>] - Find largest value in <array>",
  210.     "MEAN", dt_mean,
  211.         "<array>[,<size>] - Calc. mean average",
  212.     "MEDIAN", dt_median,
  213.         "<array>[,<size>] - Calc. median average",
  214. #ifdef LATTICE          
  215.     "MEMSTAT", dt_memstat,
  216.         " - Memory status",
  217. #endif          
  218.     "MIN", dt_min,
  219.         "<array>[,<size>] - Find smallest value in <array>",
  220.     "MIRR", dt_mirr,
  221.         "<risky>, <safe>, <flows>, <n> - Modified IRR",
  222.     "NPV", dt_npv,
  223.         "<rate>, <array>, <n> - Net Present Value function",
  224.     "NSK", dt_nsk,
  225.         "<xarray>, <zarray>[,<size>] - Normal Scores",
  226.     "PEEK", dt_peek,
  227.         "<offset>, <segment> - Peek at a memory location",
  228.     "PMT", dt_pmt,
  229.         "<prin>, <rate>, <term> - Calc. payment for a loan",
  230.     "POKE", dt_poke,
  231.         "<bytecode>, <offset>, <segment> - Write a byte into memory",
  232.     "PUTARRAY", dt_putarray,
  233.         "<id>, <index>, <value> - Put a <value> in an array",
  234.     "PUTWINDOW", dt_putwindow,
  235.     "<y1>,<x1>,<y2>,<x2>,<clear>,<type>",
  236.     "PV", dt_pv,
  237.         "<pmt>, <rate>, <term> - Present Value function",
  238.     "RAND", dt_rand,
  239.         "<lo>, <hi> - Generate random # >= lo && <= hi",
  240.     "RANGE", dt_range,
  241.         "<array>[,<size>] - Find range of values in <array>",
  242.     "RNARRAY", dt_rnarray,
  243.         "<id>, <newid> - Rename an array",
  244.     "ROS", dt_ros,
  245.         "<old>, <new>[,<size>] - Reverse Order Statistics (Sort)",
  246.     "SETBELL", dt_setbell,
  247.         "<value> - Set error bell on if nonzero",
  248.     "SETDVAR", dt_setdvar,
  249.         "<type> - Remember next memvar passed to cfunc",
  250.     "SETERR", dt_seterr,
  251.         "<value> - Set error reporting on if nonzero",
  252.     "SF", dt_sf,
  253.         "<amt>, <rate>, <periods> - Sinking Fund",
  254.     "SIN", dt_sin,
  255.         "<r> - Compute sine of <r> radians",
  256.     "SKEW", dt_skew,
  257.         "<zarray>[,<size>] - Sample Skewness",
  258.     "SOUND", dt_sound,
  259.         "<frequency>, <duration> - Generate a sound",
  260.     "STARRAY", dt_starray,
  261.         "Display the status of all arrays",
  262.     "STDEV", dt_stdev,
  263.         "<array>[,<size>] - Calculate standard deviation",
  264.     "TAN", dt_tan,
  265.         "<r> - Compute tangent of <r> radians",
  266.     "VAR", dt_var,
  267.         "<array>[,<size>] - Calc. variance",
  268.     "", 0, ""
  269.     };
  270.  
  271.  
  272. /* 
  273. *   
  274. *   Finally, call db_c_catch(). 
  275. *   
  276. */
  277. void main(argc, argv)
  278. int argc; 
  279. char *argv[];
  280. {
  281. #ifdef LATTICE
  282.     drand48();  /* initialize Lattice's random # generator */
  283. #endif
  284.  
  285. /* db_c_catch needs to know how many pages of memory to save. Part of that 
  286.  * memory is the actual program size, which we define here. Note that these
  287.  * sizes are approximate, and vary widely with different compilers and memory
  288.  * models. Some compilers provide the ability to directly access the program
  289.  * size, while others do not. Check your compiler manual, and remember that
  290.  * Prog_Size + Res_Mem must equal the total amount of memory, including all
  291.  * allocation plus about 4K for internal buffers, that will be used by the 
  292.  * program.
  293.  */
  294.  
  295. /* Prog_Size should be set to the size of the executable file plus
  296.  * the size of the stack plus at least 16 bytes. We round these
  297.  * upward to the nearest 1000 bytes in the following assignments
  298.  */
  299. #ifdef LC2
  300.     Prog_Size = 84000L; /* assumes LATTICE large model */
  301. #endif
  302. #ifdef LC3
  303.     Prog_Size = 80000L;
  304. #endif
  305. #ifdef MS
  306.     Prog_Size = 80000L; /* Microsoft large model */
  307. #endif
  308. #ifdef AZTEC
  309.     Prog_Size = 50000L; /* assumes AZTEC small model (C Prime) */
  310. #endif 
  311.     if (argc > 1)
  312.     {
  313. #ifdef LARGE
  314.         Res_Mem = min(120,atoi(argv[1]) < 0 ? 16 : atoi(argv[1]));
  315. #else
  316.         Res_Mem = min(24,atoi(argv[1]) < 0 ? 10 : atoi(argv[1]));
  317. #endif
  318.     }
  319.     else
  320.     {
  321. #ifdef LARGE
  322.         Res_Mem = 16;
  323. #else
  324.         Res_Mem = 10;
  325. #endif /* LARGE */
  326.     }
  327.  
  328.     printf("Reserving %ld bytes for arrays\n",1024L * Res_Mem);
  329.     
  330.     /* we need some reserve for internal use, so bump it up */
  331.     Res_Mem += INT_MEM_RESERVE/1024;
  332.  
  333. /* A bug in Lattice forces us to make two allocation calls, so we split up
  334.    the calls to calloc()
  335. */
  336. #ifdef LATTICE
  337.     BigBuf1 = calloc(Res_Mem,512);
  338.     BigBuf2 = calloc(Res_Mem,512);
  339. #else
  340.     BigBuf1 = calloc(Res_Mem,1024);
  341. #endif
  342. /* Freeing the memory right away assures that we protect our own internal
  343.  * memory pool from dBASE shenanigans, as long as we also tell DOS to keep
  344.  * the extra memory resident upon termination...
  345.  */
  346.     free(BigBuf1);
  347. #ifdef LATTICE  
  348.     free(BigBuf2);
  349. #endif
  350.     BigBuf1 = calloc(INT_MEM_RESERVE-ALLOC_OVHD, 1);
  351.     db_c_catch(INTRPT1,INTRPT2,
  352.     (unsigned)((((long)Res_Mem + 2L) * 1024L + Prog_Size)/16L));
  353. }
  354.  
  355.  
  356. /* 
  357. *           PUT YOUR DISPATCHED FUNCTIONS HERE
  358. */
  359.  
  360. void dt_acos(s)
  361. char    *s;
  362. {
  363. double result;
  364.  
  365.     result = acos(atof(ArgVal[1]));
  366.     SetNRet(result);
  367. }
  368.  
  369. void dt_amort(s)    /* amortization setup function */
  370. char    *s;
  371. {
  372. double  prin;   /* principle */
  373. double  rate;   /* interest */
  374. int term;   /* term */
  375. int pmts;   /* payments made */
  376. double  result, amort();
  377.  
  378.     prin = atof(ArgVal[1]);
  379.     rate = atof(ArgVal[2]);
  380.     term = atoi(ArgVal[3]);
  381.     pmts = atoi(ArgVal[4]);
  382.  
  383.     result = amort(prin, rate, term, pmts); /* do the calculation */
  384.     SetNRet(result);
  385. }
  386.  
  387. /* fill an array with random #'s */
  388.  
  389. void dt_arand(s)
  390. char    *s;
  391. {
  392. double  factor;
  393. int start, end, n;
  394. double  *dest;
  395. #ifdef AZTEC
  396. double  ran();
  397. #endif
  398.     if (*ArgVal[2])
  399.         factor = atof(ArgVal[2]);
  400.     else
  401.         factor = 1.0;
  402.     start = atoi(ArgVal[3]);
  403.     end = atoi(ArgVal[4]);
  404.     if (!end || end > arsize(ArgVal[1])-1)
  405.         end = arsize(ArgVal[1])-1;
  406.  
  407.     if (dest = (double *)fc_array(ArgVal[1]))
  408.     {
  409.         for(n = start; n <= end; n++)
  410. #ifdef AZTEC
  411.             dest[n] = ran() * factor;
  412. #endif
  413. #ifdef LATTICE
  414.             dest[n] = drand48() * factor;
  415. #endif  
  416. #ifdef MS
  417.             dest[n] = ((double) rand()/32768.0) * factor;
  418. #endif      
  419.         if (n > arcount(ArgVal[1]))
  420.             arsetcnt(ArgVal[1], n);
  421.     }
  422.     factor = (double) n;    /* just so's we return a double */
  423.     SetNRet(factor);
  424. }
  425.  
  426. /* restore an array to disk */
  427.  
  428. void dt_arestore(s) 
  429. char    *s;
  430. {
  431. double  result;
  432.  
  433.     if (*ArgVal[3])
  434.     {
  435.         if (!(*ArgVal[4]))
  436.             sprintf(ArgVal[4], "%u", arsize(ArgVal[1])-1);
  437.     }
  438.     else
  439.     {
  440.         sprintf(ArgVal[3], "0");
  441.         sprintf(ArgVal[4], "%u", arsize(ArgVal[1])-1);
  442.     }
  443.  
  444.     if ((result = (double)rest_arr(ArgVal[1], ArgVal[2],
  445.         ArgVal[3], ArgVal[4])) < 0.0)
  446.         dctmsg(MSG_IO_ERROR);
  447.     SetNRet(result);
  448. }
  449.  
  450. /* save an array to disk */
  451.  
  452. void dt_asave(s)
  453. char    *s;
  454. {
  455. double  result;
  456.  
  457.     if (*ArgVal[3])
  458.     {
  459.         if (!(*ArgVal[4]))
  460.             sprintf(ArgVal[4], "%u", arcount(ArgVal[1])-1);
  461.     }
  462.     else
  463.     {
  464.         sprintf(ArgVal[3], "0");
  465.         sprintf(ArgVal[4], "%u", arcount(ArgVal[1])-1);
  466.     }
  467.     if ((result = (double)save_arr(ArgVal[1], ArgVal[2], 
  468.         ArgVal[3], ArgVal[4])) < 0.0)
  469.         dctmsg(MSG_IO_ERROR);
  470.     SetNRet(result);
  471. }
  472.  
  473. void dt_asin(s)
  474. char    *s;
  475. {
  476. double result;
  477.  
  478.     result = asin(atof(ArgVal[1]));
  479.     SetNRet(result);
  480. }
  481.  
  482. void dt_atan(s)
  483. char    *s;
  484. {
  485. double result;
  486.  
  487.     result = atan(atof(ArgVal[1]));
  488.     SetNRet(result);
  489. }
  490.  
  491. /* dt_chi - chi-square function setup */
  492. void dt_chi(s)
  493. char    *s;
  494. {
  495. int size;
  496. double  result, chisq();
  497.  
  498.     size = atoi(ArgVal[3]);
  499.  
  500.     if (!size)  size = arsize(ArgVal[1]);
  501.  
  502.     result = chisq((double *)fc_array(ArgVal[1]), 
  503.             (double *)fc_array(ArgVal[2]), size);
  504.     SetNRet(result);
  505. }
  506.  
  507. /* dt_clrwindow - clear a window to spaces */
  508. void dt_clrwindow(s)
  509. char    *s;
  510. {
  511. int x1, x2, y1, y2;
  512. int i, j;
  513. int bord_only;  /* if non-zero (TRUE), clear only borders */
  514.  
  515.     y1 = atoi(ArgVal[1]);
  516.     x1 = atoi(ArgVal[2]);
  517.     y2 = atoi(ArgVal[3]);
  518.     x2 = atoi(ArgVal[4]);
  519.     bord_only = atoi(ArgVal[5]);
  520.     for (i = x1; i <= x2; i++)
  521.         for (j = y1; j <= y2; j++)
  522.         {
  523.             if (!bord_only || 
  524.                 (j == y1) || j == y2 || i == x1 || i == x2)
  525.             {
  526.                 curlocat(j, i);
  527.                 putchar((int)' ');
  528.             }
  529.         }
  530. }
  531.  
  532. void dt_cos(s)
  533. char    *s;
  534. {
  535. double result;
  536.  
  537.     result = cos(atof(ArgVal[1]));
  538.     SetNRet(result);
  539. }
  540.  
  541. /* void dt_count - find the total # items in array */
  542.  
  543. void dt_count(s)
  544. char    *s;
  545. {
  546. double result;
  547.  
  548.     result = (double) arcount(ArgVal[1]);
  549.     if (result < 0.0)
  550.       dctmsg(MSG_NO_ARRAY);
  551.     else
  552.       SetNRet(result);
  553. }
  554.  
  555. void dt_crarray(s)  /* setup function for creation of arrays */
  556. char    *s;
  557. {
  558. double  temp;
  559.  
  560.     temp = (double) cr_array(ArgVal[1], ArgVal[2], *ArgVal[3]);
  561.     if (temp < 0.0) SetStatus(temp);
  562.     else    SetNRet(temp);
  563. }
  564.  
  565. /* dt_corr - correlation of two arrays  */
  566.  
  567. void dt_corr(s)
  568. char    *s;
  569. {
  570. int size;   /* size of array */
  571. double  result, scorr();
  572. double  *arpt1, *arpt2;
  573.  
  574.     size = atoi(ArgVal[3]);
  575.  
  576.     if (!size)  size = min(arsize(ArgVal[1]), arsize(ArgVal[2]));
  577.     if (!(arpt1 = (double *) fc_array(ArgVal[1])) || !(arpt2 = 
  578.         (double *) fc_array(ArgVal[2])))
  579.             return;
  580.     result = scorr(arpt1, arpt2, size);
  581.     SetNRet(result);
  582. }
  583.  
  584. /* dt_covar - covariance of two arrays  */
  585.  
  586. void dt_covar(s)
  587. char    *s;
  588. {
  589. int size;   /* size of array */
  590. double  result, scovar();
  591. double  *arpt1, *arpt2;
  592.  
  593.     size = atoi(ArgVal[3]);
  594.  
  595.     if (!size)  size = min(arsize(ArgVal[1]), arsize(ArgVal[2]));
  596.     if (!(arpt1 = (double *) fc_array(ArgVal[1])) || !(arpt2 = 
  597.         (double *) fc_array(ArgVal[2])))
  598.             return;
  599.  
  600.     result = scovar(arpt1, arpt2, size);
  601.     SetNRet(result);
  602. }
  603.  
  604. /* dt_cv - find the coefficient of variance of values in an array */
  605.  
  606. void dt_cv(s)
  607. char    *s;
  608. {
  609. int size;   /* size of array */
  610. double  result, scv();
  611.  
  612.     size = atoi(ArgVal[2]);
  613.     if (!size)  size = arsize(ArgVal[1]);
  614.  
  615.     result = scv((double *)fc_array(ArgVal[1]), size);
  616.     SetNRet(result);
  617. }
  618.  
  619. /* dt_dist - produce distribution frequency */
  620.  
  621. void dt_dist(s)
  622. char    *s;
  623. {
  624. int size;   /* size of array */
  625. double  result;
  626. double  *arpt[4];
  627. int i;
  628.  
  629.     for (i = 0; i < 4; i++)
  630.         if ((arpt[i] = (double *)fc_array(ArgVal[i+1])) == (char *) 0)
  631.             return;
  632.     size = atoi(ArgVal[5]);
  633.  
  634.     if (!size)  size = arsize(ArgVal[1]);
  635.     result = (double) sdist(arpt[0], arpt[1], arpt[2], arpt[3], size);
  636.     arsetcnt(ArgVal[2], size);
  637.     arsetcnt(ArgVal[3], size);
  638.     arsetcnt(ArgVal[4], size);
  639.  
  640.     SetNRet(result);
  641. }
  642.  
  643. void dt_dumparray(s)    /* setup function for dumping array */
  644. char    *s;
  645. {
  646. double  temp;
  647.  
  648.     if (*ArgVal[2])
  649.     {
  650.         if (!(*ArgVal[3]))
  651.             sprintf(ArgVal[3], "%u", arcount(ArgVal[1])-1);
  652.     }
  653.     else
  654.     {
  655.         sprintf(ArgVal[2], "0");
  656.         sprintf(ArgVal[3], "%u", arcount(ArgVal[1])-1);
  657.     }
  658.  
  659.     temp = (double) dump_array(ArgVal[1], ArgVal[2], ArgVal[3]);
  660.  
  661.     SetNRet(temp);
  662. }
  663.  
  664. /* dt_eqn - find a value > than a given number */
  665.  
  666. void dt_eqn(s)
  667. char    *s;
  668. {
  669. double  value;  /* number to be compared */
  670. int size;   /* size of array */
  671. double  result;
  672.  
  673.     value = atof(ArgVal[1]);
  674.     size = atoi(ArgVal[3]);
  675.     if (!size)  size = arsize(ArgVal[2]);
  676.  
  677.     result = (double) seqn(value, (double *)fc_array(ArgVal[2]), size);
  678.     SetNRet(result);
  679. }
  680.  
  681. void dt_fdump(s)   /* setup function for dumping array to file */
  682. char    *s;
  683. {
  684. double  temp;
  685.  
  686.     if (*ArgVal[3])
  687.     {
  688.         if (!(*ArgVal[4]))
  689.             sprintf(ArgVal[4], "%u", arcount(ArgVal[1])-1);
  690.     }
  691.     else
  692.     {
  693.         sprintf(ArgVal[3], "0");
  694.         sprintf(ArgVal[4], "%u", arcount(ArgVal[1])-1);
  695.     }
  696.  
  697.     temp = (double) fdump_array(ArgVal[1], ArgVal[2],
  698.             ArgVal[3], ArgVal[4]);
  699.  
  700.     SetNRet(temp);
  701. }
  702.  
  703. void dt_frarray(s)  /* setup function for freeing arrays */
  704. char    *s;
  705. {
  706. double  temp;
  707.  
  708.     temp = (double) fr_array(ArgVal[1]);
  709.  
  710.     if (temp < 0.0)
  711.         SetStatus(temp);
  712. }
  713.  
  714. void dt_fv(s)       /* future value setup function */
  715. char    *s;
  716. {
  717. double  pmt;    /* payment per term */
  718. double  interest;   /* interest per term */
  719. int term;   /* term of note */
  720. double  result, /* place to hold result */
  721.     fv();   /* actual calculation done by this guy */
  722.  
  723.     pmt = atof(ArgVal[1]);
  724.     interest = atof(ArgVal[2]);
  725.     term = atoi(ArgVal[3]);
  726.  
  727.     result = fv(pmt, interest, term);
  728.     SetNRet(result);
  729.  
  730. }
  731.  
  732. /* dt_gen - find a value >= than a given number */
  733.  
  734. void dt_gen(s)
  735. char    *s;
  736. {
  737. double  value;  /* number to be compared */
  738. int size;   /* size of array */
  739. double  result;
  740.  
  741.     value = atof(ArgVal[1]);
  742.     size = atoi(ArgVal[3]);
  743.     if (!size)  size = arsize(ArgVal[2]);
  744.  
  745.     result = (double) sgen(value, (double *)fc_array(ArgVal[2]), size);
  746.     SetNRet(result);
  747. }
  748.  
  749. void dt_getarray(s) /* setup function for getting values from arrays */
  750. char    *s;
  751. {
  752. double  temp;
  753.  
  754.     temp = (double) get_arv(ArgVal[1], ArgVal[2]);
  755.  
  756.     if (temp < 0.0)
  757.         SetStatus(temp);
  758. }
  759.  
  760. /* dt_gtn - find a value > than a given number */
  761.  
  762. void dt_gtn(s)
  763. char    *s;
  764. {
  765. double  value;  /* number to be compared */
  766. int size;   /* size of array */
  767. double  result;
  768.  
  769.     value = atof(ArgVal[1]);
  770.     size = atoi(ArgVal[3]);
  771.     if (!size)  size = arsize(ArgVal[2]);
  772.  
  773.     result = (double) sgtn(value, (double *)fc_array(ArgVal[2]), size);
  774.     SetNRet(result);
  775. }
  776.  
  777. /* setup function for password */
  778. void dt_getpass(s)  
  779. char    *s;
  780. {
  781. char    passbuf[10];
  782.  
  783. /*
  784.     DB_ERRFLG = atoi(dt_token);
  785. */
  786. /* Get a 1 to 8 character password. Only the enter key terminates the input.
  787.  * Ring the bell on an invalid response. Backspace key will delete 
  788.  * characters. No automatic return 
  789.  */
  790.     getpass(8, 1, 1, 0, passbuf, 1, '#');
  791.     SetCRet(passbuf);
  792. }
  793.  
  794. /* dt_getsize - return the size of an array */
  795.  
  796. void dt_getsize(s)
  797. char    *s;
  798. {
  799. double result;
  800.  
  801.     result = (double) arsize(ArgVal[1]);
  802.     SetNRet(result);
  803. }
  804.  
  805. /*  dt_help simply lists all the functions available to the user */
  806. void dt_help(s)
  807. char    *s;
  808. {
  809. int i;
  810.  
  811.     putwindow(1,0,(*ArgVal[1] ? 3 : 11),79, BigBuf1, 1, 1);
  812.  
  813.     for (i = 0; ci_DispTable[i].F_Ptr; i++)
  814.     {
  815.         if (*ArgVal[1] == '\0')
  816.         {
  817.             curlocat(2+(i/7),1+((i % 7)*10));
  818.             printf("%s", ci_DispTable[i].F_Name);
  819.         }
  820.         else if (strccmp(ci_DispTable[i].F_Name, ArgVal[1]) == 0)
  821.         {
  822.             curlocat(2,1);
  823.             printf("%s %s", ci_DispTable[i].F_Name,
  824.             ci_DispTable[i].F_Descr);
  825.             break;
  826.         }
  827.     }
  828.     if (*ArgVal[1] && !ci_DispTable[i].F_Ptr)
  829.     {
  830.         curlocat(2,1);
  831.         printf(" No such function.");
  832.     }
  833.     getkeycl(&i);
  834.     if (i != 0x1b)
  835.         rstwindo(1,0,(*ArgVal[1] ? 3 : 11),79, BigBuf1);
  836. }
  837.  
  838. void dt_irr(s)  /* internal rate of return setup function */
  839. char    *s;
  840. {
  841. double  guess;  /* initial guess */
  842. int term;   /* term */
  843. double  result, irr();
  844.  
  845.     guess = atof(ArgVal[1]);
  846.     term = atoi(ArgVal[3]);
  847.     if (!term)  term = arsize(ArgVal[2]);
  848.  
  849.     result = irr(guess, (double *)fc_array(ArgVal[2]), term);
  850.     SetNRet(result); /* put result in memvar */
  851. }
  852.  
  853. /* dt_kurt - calculate kurtosis of normal scores */
  854.  
  855. void dt_kurt(s)
  856. char    *s;
  857. {
  858. int size;   /* size of array */
  859. double  result, skurt();
  860. double  *arpt1;
  861.  
  862.     size = atoi(ArgVal[2]);
  863.     if (!size)  size = arsize(ArgVal[1]);
  864.  
  865.     if (!(arpt1 = (double *) fc_array(ArgVal[1]))) 
  866.             return;
  867.     result = skurt((double *)fc_array(ArgVal[1]), size);
  868.     SetNRet(result);
  869. }
  870.  
  871.  
  872. /* dt_len - find a value <= than a given number */
  873.  
  874. void dt_len(s)
  875. char    *s;
  876. {
  877. double  value;  /* number to be compared */
  878. int size;   /* size of array */
  879. double  result;
  880.  
  881.     value = atof(ArgVal[1]);
  882.     size = atoi(ArgVal[3]);
  883.     if (!size)  size = arsize(ArgVal[2]);
  884.  
  885.     result = (double) slen(value, (double *)fc_array(ArgVal[2]), size);
  886.     SetNRet(result);
  887. }
  888.  
  889. /* dt_ltn - find a value < than a given number */
  890.  
  891. void dt_ltn(s)
  892. char    *s;
  893. {
  894. double  value;  /* number to be compared */
  895. int size;   /* size of array */
  896. double  result;
  897.  
  898.     value = atof(ArgVal[1]);
  899.     size = atoi(ArgVal[3]);
  900.     if (!size)  size = arsize(ArgVal[2]);
  901.  
  902.     result = (double) sltn(value, (double *)fc_array(ArgVal[2]), size);
  903.     SetNRet(result);
  904. }
  905.  
  906. /* dt_max - find the maximum value in an array */
  907.  
  908. void dt_max(s)
  909. char    *s;
  910. {
  911. int size;   /* size of array */
  912. double  result, smax();
  913.  
  914.     size = atoi(ArgVal[2]);
  915.     if (!size)  size = arsize(ArgVal[1]);
  916.  
  917.     result = smax((double *)fc_array(ArgVal[1]), size);
  918.     SetNRet(result);
  919. }
  920.  
  921. /* dt_mean - find the mean average of values in an array */
  922.  
  923. void dt_mean(s)
  924. char    *s;
  925. {
  926. int size;   /* size of array */
  927. double  result, smean();
  928.  
  929.     size = atoi(ArgVal[2]);
  930.     if (!size)  size = arsize(ArgVal[1]);
  931.  
  932.     result = smean((double *)fc_array(ArgVal[1]), size);
  933.     SetNRet(result);
  934. }
  935.  
  936. #ifdef LATTICE
  937. /* dt_memstat - report memory status */
  938.  
  939. void dt_memstat(s)
  940. char    *s;
  941. {
  942. double  memavail;
  943.  
  944.     memavail = (double) (sizmem() - INT_MEM_RESERVE < 0L ? 0L :
  945.         sizmem()-INT_MEM_RESERVE);
  946.     SetNRet(memavail);
  947. }
  948. #endif
  949.  
  950. /* dt_median - find the median average of values in an array */
  951.  
  952. void dt_median(s)
  953. char    *s;
  954. {
  955. int size;   /* size of array */
  956. double  result, smedian();
  957.  
  958.     size = atoi(ArgVal[2]);
  959.     if (!size)  size = arsize(ArgVal[1]);
  960.  
  961.     result = smedian((double *)fc_array(ArgVal[1]), size);
  962.     SetNRet(result);
  963. }
  964.  
  965. void dt_min(s)
  966. char    *s;
  967. {
  968. int size;   /* size of array */
  969. double  result, smin();
  970.  
  971.     size = atoi(ArgVal[2]);
  972.     if (!size)  size = arsize(ArgVal[1]);
  973.  
  974.     result = smin((double *)fc_array(ArgVal[1]), size);
  975.     SetNRet(result);
  976. }
  977.  
  978. void dt_mirr(s) /* modified internal rate of return setup function */
  979. char    *s;
  980. {
  981. double  risky, safe;    /* risky & safe interest rates */
  982. int term;       /* term */
  983. double  result, mirr();
  984.  
  985.     risky = atof(ArgVal[1]);
  986.     safe = atof(ArgVal[2]);
  987.     term = atoi(ArgVal[4]);
  988.     if (!term)  term = arsize(ArgVal[3]);
  989.  
  990.     result = mirr(risky, safe, (double *)fc_array(ArgVal[3]), term);
  991.     SetNRet(result); /* put result in memvar */
  992. }
  993.  
  994. /* dt_nsk - produce normal scores from array */
  995.  
  996. void dt_nsk(s)
  997. char    *s;
  998. {
  999. int size;   /* size of array */
  1000. double  result;
  1001. double  *arpt1, *arpt2;
  1002.  
  1003.     size = atoi(ArgVal[3]);
  1004.  
  1005.     if (!size)  size = arsize(ArgVal[2]);
  1006.     if (!(arpt1 = (double *) fc_array(ArgVal[1])) || !(arpt2 = 
  1007.         (double *) fc_array(ArgVal[2])))
  1008.             return;
  1009.  
  1010.     snsk(arpt1, arpt2, size);
  1011.     arsetcnt(ArgVal[2], size); /* reset count of array2 */
  1012.     result = (double) size;
  1013.     SetNRet(result);
  1014. }
  1015.  
  1016. void dt_npv(s)  /* net present value setup function */
  1017. char    *s;
  1018. {
  1019. double  interest;   /* interest */
  1020. int term;   /* term */
  1021. double  result, npv();
  1022.  
  1023.     interest = atof(ArgVal[1]);
  1024.     term = atoi(ArgVal[3]);
  1025.  
  1026.     result = npv(interest, (double *)fc_array(ArgVal[2]), term);
  1027.     SetNRet(result);
  1028. }
  1029.  
  1030. /* setup for memory peek function */
  1031. void dt_peek(s)
  1032. char *s;
  1033. {
  1034. unsigned    offset, segment;
  1035. char        bytecode;
  1036. double      result;
  1037.  
  1038.     offset = atoi(ArgVal[1]);
  1039.     segment = atoi(ArgVal[2]);
  1040.     bytecode = peekbyte(offset, segment);
  1041.     result = (double) bytecode;
  1042.     SetNRet(result);
  1043. }
  1044.     
  1045. void dt_pmt(s)  /* pmt setup function */
  1046. char    *s;
  1047. {
  1048. double  prin;   /* principle */
  1049. double  rate;   /* interest */
  1050. int term;   /* term */
  1051. double  result, pmt();
  1052.  
  1053.     prin = atof(ArgVal[1]);
  1054.     rate = atof(ArgVal[2]);
  1055.     term = atoi(ArgVal[3]);
  1056.  
  1057.     result = pmt(prin, rate, term); /* do the calculation */
  1058.     SetNRet(result);
  1059. }
  1060.  
  1061. /* setup for memory poke function */
  1062. void dt_poke(s)
  1063. char *s;
  1064. {
  1065. unsigned    offset, segment;
  1066. char    bytecode;
  1067.  
  1068.     bytecode = (char)atoi(ArgVal[1]);
  1069.     offset = atoi(ArgVal[2]);
  1070.     segment = atoi(ArgVal[3]);
  1071.     pokebyte(bytecode, offset, segment);
  1072. }
  1073.  
  1074. void dt_putarray(s) /* setup function for putting values into arrays */
  1075. char    *s;
  1076. {
  1077. char    id[13];
  1078. char    index[20];
  1079. char    value[255];
  1080. double  temp;
  1081.  
  1082.     s = GetFunc(dt_token, s);
  1083.     s = GetNext(id, s);
  1084.     s = GetNext(index, s);
  1085.     s = GetString(value, s);
  1086.     temp = (double) put_arv(id, index, value);
  1087.     if (temp < 0.0) SetStatus(temp);
  1088.     else    SetNRet(temp);
  1089. }
  1090.  
  1091. /* setup for putwindow function */
  1092. void dt_putwindow(s)    
  1093. char    *s;
  1094. {
  1095. int x1,y1,x2,y2;
  1096. int type;       /* 0 =single line, non-zero =double line */
  1097. int clear;      /* non-zero will clear contents of window */
  1098.  
  1099.     y1 = atoi(ArgVal[1]);
  1100.     x1 = atoi(ArgVal[2]);
  1101.     y2 = atoi(ArgVal[3]);
  1102.     x2 = atoi(ArgVal[4]);
  1103.     clear = atoi(ArgVal[5]);
  1104.     type = atoi(ArgVal[6]);
  1105.     putwindow(y1,x1,y2,x2,(int *)0,clear,type);
  1106. }
  1107.  
  1108. void dt_pv(s)   /* present value setup function */
  1109. char    *s;
  1110. {
  1111. double  pmt;    /* payment */
  1112. double  interest;   /* interest */
  1113. int term;   /* term */
  1114. double  result, pv();
  1115.  
  1116.     pmt = atof(ArgVal[1]);
  1117.     interest = atof(ArgVal[2]);
  1118.     term = atoi(ArgVal[3]);
  1119.  
  1120.     result = pv(pmt, interest, term);   /* do the calculation */
  1121.     SetNRet(result);
  1122. }
  1123.  
  1124. void dt_rand(s) /* Setup function for random number generation */
  1125. char    *s;
  1126. {
  1127. int low, high, w, temp;
  1128. #ifdef LC2
  1129. long    newseed;
  1130. #endif
  1131. #ifdef LC3
  1132. unsigned newseed;
  1133. #endif
  1134. #ifdef MS
  1135. unsigned newseed;
  1136. #endif
  1137. double  result;
  1138. #ifdef AZTEC
  1139. double dtemp, ran();
  1140. #endif
  1141.  
  1142.     if (*ArgVal[2])
  1143.     {
  1144.         low = atoi(ArgVal[1]);
  1145.         high = atoi(ArgVal[2]);
  1146.         w = high - low + 1;     /* width of range */
  1147. #ifdef AZTEC
  1148.         temp = (int)(ran() * w);
  1149. #else
  1150.         temp = rand();
  1151.         temp /= (32767/w);  /* make sure it's in range */
  1152. #endif
  1153.         result = (double) ( temp+low >= high ? high : temp + low);
  1154.     }
  1155.     else
  1156.     {
  1157. #ifndef AZTEC    
  1158.         if (*ArgVal[1])
  1159. #endif
  1160. #ifdef AZTEC
  1161.             result = ran();
  1162. #endif      
  1163. #ifdef LC2
  1164.         {
  1165.             newseed = atol(ArgVal[1]); 
  1166.             srand48(newseed);
  1167.         }
  1168.         result = drand48();
  1169. #endif
  1170. #ifdef LC3
  1171.         {
  1172.             newseed = (unsigned int)atoi(ArgVal[1]);
  1173.             srand48((long)newseed);
  1174.         }
  1175.         result = drand48();
  1176. #endif
  1177. #ifdef MS
  1178.         {
  1179.             newseed = (unsigned int)atoi(ArgVal[1]);
  1180.             srand(newseed);
  1181.         }
  1182.         result = (double) rand();
  1183. #endif
  1184.     }
  1185.     SetNRet(result);
  1186. }
  1187.  
  1188. /* dt_range - find the range of values in an array */
  1189.  
  1190. void dt_range(s)
  1191. char    *s;
  1192. {
  1193. int size;   /* size of array */
  1194. double  result, srange();
  1195.  
  1196.     size = atoi(ArgVal[2]);
  1197.     if (!size)  size = arsize(ArgVal[1]);
  1198.  
  1199.     result = srange((double *)fc_array(ArgVal[1]), size);
  1200.     SetNRet(result);
  1201. }
  1202.  
  1203. /* setup function for renaming arrays */
  1204. void dt_rnarray(s)
  1205. char    *s;
  1206. {
  1207. double  temp;
  1208.  
  1209.     temp = (double) rn_array(ArgVal[1], ArgVal[2]);
  1210.     SetStatus(temp);
  1211. }
  1212.  
  1213. /* dt_ros - produce reverse order statistics (sorted array) */
  1214.  
  1215. void dt_ros(s)
  1216. char    *s;
  1217. {
  1218. int size;   /* size of array */
  1219. double  result;
  1220. double  *arpt1, *arpt2;
  1221.  
  1222.     size = atoi(ArgVal[3]);
  1223.  
  1224. /* only sort as many as destination array will hold */
  1225.     if (!size)  size = arsize(ArgVal[2]);
  1226.  
  1227.     if (!(arpt1 = (double *) fc_array(ArgVal[1])) || !(arpt2 = 
  1228.         (double *) fc_array(ArgVal[2])))
  1229.             return;
  1230.     result = (double) sros(arpt1, arpt2, size);
  1231.  
  1232.     arsetcnt(ArgVal[2], size); /* reset count of array2 */
  1233.     SetNRet(result);
  1234. }
  1235.  
  1236. /* dt_setdvar informs the package that the next thing passed from
  1237. * dbase will be the address of the contents of a memory variable.
  1238. * In this way, the location of those contents can be remembered, and
  1239. * we can communicate with dbase
  1240. */
  1241.  
  1242. void dt_setdvar(s)
  1243. char    *s;
  1244. {
  1245.     DB_VARTYPE = toupper(*ArgVal[1]);
  1246.     if (DB_VARTYPE != 'C' && DB_VARTYPE != 'D' && DB_VARTYPE != 'L' 
  1247.       && DB_VARTYPE != 'N' && DB_VARTYPE != 'S' 
  1248.       && DB_VARTYPE != 'M' && DB_VARTYPE != 'E')
  1249.         dctmsg(MSG_INV_TYPE);
  1250.     else
  1251.         DB_SETFLAG = 1; /* set up to remember dbase variable */
  1252. }
  1253.  
  1254. /* set error bell flag */
  1255. void dt_setbell(s)
  1256. char    *s;
  1257. {
  1258.     DB_BELLFLG = atoi(ArgVal[1]);
  1259. }
  1260.  
  1261. void dt_seterr(s)   /* set error reporting flag */
  1262. char    *s;
  1263. {
  1264.  
  1265.     DB_ERRFLG = atoi(ArgVal[1]);
  1266. }
  1267.  
  1268. void dt_sf(s)   /* sinking fund setup function */
  1269. char    *s;
  1270. {
  1271. double  prin;   /* principle */
  1272. double  rate;   /* interest */
  1273. int term;   /* term */
  1274. double  result, sf();
  1275.  
  1276.     prin = atof(ArgVal[1]);
  1277.     rate = atof(ArgVal[2]);
  1278.     term = atoi(ArgVal[3]);
  1279.  
  1280.     result = sf(prin, rate, term);  /* do the calculation */
  1281.     SetNRet(result);
  1282. }
  1283.  
  1284. void dt_sin(s)  
  1285. char    *s;
  1286. {
  1287. double result;
  1288.  
  1289.     result = sin(atof(ArgVal[1]));
  1290.     SetNRet(result);
  1291. }
  1292.  
  1293. /* dt_skew - calculate skewness of normal scores */
  1294.  
  1295. void dt_skew(s)
  1296. char    *s;
  1297. {
  1298. int size;   /* size of array */
  1299. double  result, sskew();
  1300. double  *arpt1;
  1301.  
  1302.     size = atoi(ArgVal[2]);
  1303.  
  1304.     if (!size)  size = arsize(ArgVal[1]);
  1305.     if (!(arpt1 = (double *) fc_array(ArgVal[1])))
  1306.             return;
  1307.  
  1308.     result = sskew(arpt1, size);
  1309.     SetNRet(result);
  1310. }
  1311.  
  1312. /* setup for generating sound */
  1313.  
  1314. void dt_sound(s)
  1315. char    *s;
  1316. {
  1317. int frequency;
  1318. unsigned duration;
  1319.  
  1320.     frequency = atoi(ArgVal[1]);
  1321.     duration = atoi(ArgVal[2]);
  1322. /* frequencies less than 20 cause a divide overflow */  
  1323.     sound(frequency < 20 ? 20 : frequency, duration);
  1324. }
  1325.  
  1326. void dt_starray(s)  /* setup function for getting array status info */
  1327. char    *s;
  1328. {
  1329. double  temp;
  1330.  
  1331.     temp = (double) st_arrays();
  1332.     SetStatus(temp);
  1333. }
  1334.  
  1335. /* dt_stdev - find the standard deviation of values in an array */
  1336.  
  1337. void dt_stdev(s)
  1338. char    *s;
  1339. {
  1340. int size;   /* size of array */
  1341. double  result, sstdev();
  1342.  
  1343.     size = atoi(ArgVal[2]);
  1344.     if (!size)  size = arsize(ArgVal[1]);
  1345.  
  1346.     result = sstdev((double *)fc_array(ArgVal[1]), size);
  1347.     SetNRet(result);
  1348. }
  1349.  
  1350. void dt_tan(s)
  1351. char    *s;
  1352. {
  1353. double result;
  1354.  
  1355.     result = tan(atof(ArgVal[1]));
  1356.     SetNRet(result);
  1357. }
  1358.  
  1359. /* dt_var - find the variance of values in an array */
  1360.  
  1361. void dt_var(s)
  1362. char    *s;
  1363. {
  1364. int size;   /* size of array */
  1365. double  result, svar();
  1366.  
  1367.     size = atoi(ArgVal[2]);
  1368.     if (!size)  size = arsize(ArgVal[1]);
  1369.  
  1370.     result = svar((double *)fc_array(ArgVal[1]), size);
  1371.     SetNRet(result);
  1372. }
  1373.  
  1374.  
  1375.